{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit DirectXFont;

interface

uses Classes, Types, AHMTypes, Canvas, Colour, RenderCache, Scrolling,
     Direct3D9;

const
  MAX_TEXTURE_WIDTH = 1024; // Maximum font cache texture width
  MAX_TEXTURE_HEIGHT = 1024; // Maximum font cache texture height (1M per font!)
  MIN_TEXTURE_HEIGHT = 128; // Minimum font cache texture height (128K per font)

  // Special characters for our Font renderer
  EOL_CHARS = [10, 13];
  WRAP_CHARS = [32..47, 58..63, 91..96, 123..127];
  DISPLAY_CHARS = [32..255];
  DISPLAY_CURSOR = Ord('_');

type
  TAHMCharset = 32..255;
  TAHMFontMetric = packed record
                     Bounds: TAHMRectF;
                     ScaledWidth: Single;
                     ScaledHeight: Single;
                   end;
  TAHMFontMetrics = array[TAHMCharset] of TAHMFontMetric;

  TAHMDXFont = class
  private
    FPadding: Integer;
    FKerning: Single;
    FPitch: Single;
    FScale: Single;
    FVScale: Single;
    FHScale: Single;
    FFont: TAHMCanvasFont;
    FCache: TAHMRenderCache;
    FMetrics: TAHMFontMetrics;
    FFontColour: TAHMCanvasColour;
    FShadowColour: TAHMCanvasColour;
    FLineLengths: TList;
    function GetLineLength(Line: Integer): Single;
    function WordWrapText(const Text: String; FitWidth: Single): String;
    procedure CalculateLineLengths(const Text: String);
  protected
    property LineLength[Line: Integer]: Single read GetLineLength;
    property CanvasFont: TAHMCanvasFont read FFont write FFont;
    procedure BuildFont(MaxWidth, MaxHeight, MinHeight: Integer);
    procedure TextRect(Rect, ClipRect: TAHMRectF; Text: String; Align: TAHMTextAlign;
                       WordWrap, Clip: Boolean; Scroller: TAHMAbstractScroller;
                       Shade: TAHMCanvasShade; Gamma: TAHMCanvasColour;
                       XScale, YScale: Single; XFlip, YFlip: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TAHMDXFontManager = class
  private
    FMaxTextureHeight: Integer;
    FMaxTextureWidth: Integer;
    FMinTextureHeight: Integer;
    FFontList: TList;
    FLogPixHeight: Integer;
    FFontQuality: TAHMFontQuality;
    procedure SetFontQuality(Quality: TAHMFontQuality);
    function GetDXFont(Index: Integer): TAHMDXFont;
    function GetCount: Integer;
  protected
    procedure ReleaseFonts;
  public
    constructor Create;
    destructor Destroy; override;
    property FontQuality: TAHMFontQuality read FFontQuality write SetFontQuality;
    property LogicalPixelHeight: Integer read FLogPixHeight write FLogPixHeight;
    property Count: Integer read GetCount;
    function AllocateFont(CanvasFont: TAHMCanvasFont): TAHMDXFont;
    procedure ReleaseFont(CanvasFont: TAHMCanvasFont);
    procedure TextRect(Rect: TAHMRectF; Font: TAHMCanvasFont; Text: String; Align: TAHMTextAlign;
                       WordWrap: Boolean; Scroller: TAHMAbstractScroller; Shade: TAHMCanvasShade;
                       Gamma: TAHMCanvasColour; XScale, YScale: Single; XFlip, YFlip: Boolean); overload;
    procedure TextRect(Rect, ClipRect: TAHMRectF; Font: TAHMCanvasFont; Text: String; Align: TAHMTextAlign;
                       WordWrap: Boolean; Scroller: TAHMAbstractScroller; Shade: TAHMCanvasShade;
                       Gamma: TAHMCanvasColour; XScale, YScale: Single; XFlip, YFlip: Boolean); overload;
    procedure OnLostDevice;
    procedure OnResetDevice;
    procedure ReleaseResources;
  end;


implementation

uses
 SysUtils, Math, Windows, DirectXHelper, Logging, DXErr9, Screen;

constructor TAHMDXFont.Create;
begin
  inherited;

  FCache := TAHMRenderCache.Create;
  FFontColour := TAHMCanvasColour.Create;
  FShadowColour := TAHMCanvasColour.Create;
  FLineLengths := TList.Create;
end;

destructor TAHMDXFont.Destroy;
begin
  FCache.Free;
  FFontColour.Free;
  FShadowColour.Free;
  FLineLengths.Free;

  // Canvas font is no longer cached
  FFont.Cached := False;

  inherited;
end;

procedure TAHMDXFont.BuildFont(MaxWidth, MaxHeight, MinHeight: Integer);
var
  i: TAHMCharSet;
  X, Y, MaxX, MaxY: Single;
  RowHeight: Integer;
  CalcRect: TAHMRectF;
  Buffer: TAHMDrawBuffer;
begin
  // Ignore request to build if already built
  if FFont.Cached then Exit;

  // Tweak kerning to match font style
  if FFont.Italic then FKerning := -1 / ScreenInstance.PhysicalWidth
  else if FFont.Underline then FKerning := 0
  else FKerning := 1 / ScreenInstance.PhysicalHeight;

  // Tweak padding to match font size/style
  FPadding := (FFont.OriginalSize div 5) + 1;
  if FFont.Glow then FPadding := FPadding * 2;

  // Create a monochrome draw buffer for rendering our font
  Buffer := TAHMDrawBuffer.Create;
  try
    // Create an initial single pixel buffer so we can measure text
    Buffer.Width := 1;
    Buffer.Height := 1;
    Buffer.Monochrome := True;

    FPitch := Buffer.Canvas.PrepareGDIText(FFont);
    try
      MaxX := 0.0;
      MaxY := 0.0;

      // First pass - measure each of our character dimensions
      for i := Low(TAHMCharSet) to High(TAHMCharSet) do
      begin
        Buffer.Canvas.MeasureGDIText(CalcRect, Chr(i));
        MaxX := MaxX + CalcRect.Width + FPadding;
        if CalcRect.Height > MaxY then MaxY := CalcRect.Height;
      end;
    finally
      Buffer.Canvas.UnPrepareGDIText;
    end;

    // Now we calculate the most appropriate buffer size. Large fonts are
    // scaled down to avoid excessive memory use and small fonts are scaled
    // up to improve appearance. DirectX later scales them to correct size
    FScale := 1.0;
    RowHeight := Ceil(MaxX * MaxY / MaxWidth * 1.1); // 10% fudging!
    if RowHeight > MaxHeight then
    begin
      FScale := Sqrt(MaxHeight / RowHeight);
      RowHeight := MaxHeight;
      FFont.ScaleFont(FScale);
    end
    else if RowHeight < MinHeight then
    begin
      FScale := Sqrt(MinHeight / RowHeight);
      RowHeight := MinHeight;
      FFont.ScaleFont(FScale);
    end;

    // Resize our buffer to hold the whole character set
    Buffer.Width := MaxWidth;
    Buffer.Height := Round(RowHeight * 1.50);
    Buffer.Canvas.Clear;

    // Tweak font scale and pitch to match physical screen size, with a
    // little fugde factor to match size of previous D3DX font implementation
    with ScreenInstance do
    begin
      FPitch := FPitch / VirtualHeight * 1.15;
      FScale := FScale * VirtualHeight / PhysicalHeight / 1.2;
      FVScale := PhysicalHeight * FScale / Buffer.Height;
      FHScale := PhysicalWidth * FScale / Buffer.Width;
    end;

    // Prepare our buffer for GDI+ font rendering
    Buffer.Canvas.PrepareGDIText(FFont);
    try
      // Initialise start position
      X := FPadding;
      Y := FPadding;
      MaxY := 0;

      // Measure then render each character for our charset
      for i := Low(TAHMCharset) to High(TAHMCharset) do
      begin
        Buffer.Canvas.MeasureGDIText(CalcRect, Chr(i));

        // Wrap around to next line if next char doesnt fit fully
        if X + CalcRect.Width + FPadding > MaxWidth then
        begin
          X := FPadding;
          Y := Ceil(Y + MaxY + FPadding);
        end;

        // Store character bounds in our metrics array
        FMetrics[i].Bounds.X := X / Buffer.Width;
        FMetrics[i].Bounds.Y := Y / Buffer.Height;
        FMetrics[i].Bounds.Width := CalcRect.Width / Buffer.Width;
        FMetrics[i].Bounds.Height := CalcRect.Height / Buffer.Height;
        FMetrics[i].ScaledWidth := CalcRect.Width / ScreenInstance.PhysicalWidth / FScale;
        FMetrics[i].ScaledHeight := CalcRect.Height / ScreenInstance.PhysicalHeight / FScale;
        if CalcRect.Height > MaxY then MaxY := CalcRect.Height;

        Buffer.Canvas.DrawGDIText(X, Y, Chr(i));
        X := Ceil(X + CalcRect.Width + FPadding);
      end;
    finally
      Buffer.Canvas.UnPrepareGDIText;
    end;

    // Apply post-processing effects to font cache if required
    if FFont.Glow then Buffer.ProcessBitmap(bpGlow);

    // Blit our drawbuffer into our sprite
    FCache.DrawBuffer := Buffer;
    FCache.BuildCache(Buffer.BufferRect);
  finally
    Buffer.Free;
  end;

  // Yay, our font is ready for use
  FFont.Cached := True;
end;

function TAHMDXFont.GetLineLength(Line: Integer): Single;
begin
  if (Line >= 0) and (Line < FLineLengths.Count) then
    Result := Single(FLineLengths[Line])
  else
    Result := 0.0;
end;

function TAHMDXFont.WordWrapText(const Text: String; FitWidth: Single): String;
var
  i: Integer;
  Char: Integer;
  LastSpace, LastWrap, Offset: Integer;
  LineLen, SpaceLen, WrapLen: Single;
begin
  // Set default Result - copy source string
  Result := Text;

  LastSpace := 0; LastWrap := 0; Offset := 0;
  LineLen := 0.0; SpaceLen := 0.0; WrapLen := 0.0;

  // Nibble through string wrapping lines with CR
  for i := 1 to Length(Text) do
  begin
    // Wrap text if line is excessively long
    if LineLen >= FitWidth then
    begin
      if LastSpace > 0 then
      begin
        Result[LastSpace + Offset] := Chr(CHAR_LF);
        LineLen := LineLen - SpaceLen;
      end
      else if LastWrap > 0 then
      begin
        Insert(Chr(CHAR_LF), Result, LastWrap + Offset + 1);
        Inc(Offset);
        LineLen := LineLen - WrapLen;
      end
      else
      begin
        Insert(Chr(CHAR_LF), Result, i + Offset);
        LineLen := 0;
      end;

      LastSpace := 0; LastWrap := 0;
    end;

    // Get next char and determine how we handle it
    Char := Ord(Text[i]);

    if Char in EOL_CHARS then
    begin
      // Newline, so no need to wrap
      LineLen := 0.0; LastSpace := 0; LastWrap := 0;
      Continue;
    end;

    // Increment line length by width of this character
    if Char in DISPLAY_CHARS then
      LineLen := LineLen + FMetrics[Char].ScaledWidth + FKerning;

    if Char in WRAP_CHARS then
    begin
      // Mark last occurence of space or other wrap char
      if Char = CHAR_SPC then
      begin
        LastSpace := i;
        SpaceLen := LineLen;
      end
      else
      begin
        LastWrap := i;
        WrapLen := LineLen;
      end;
    end;
  end;
end;

procedure TAHMDXFont.CalculateLineLengths(const Text: String);
var
  i: Integer;
  Char: Integer;
  LineLen: Single;
begin
  // Clear previous line lengths
  FLineLengths.Clear;

  LineLen := 0.0;

  // Nibble through string measuring line lengths
  for i := 1 to Length(Text) do
  begin
    Char := Ord(Text[i]);

    if Char = CHAR_LF then
    begin
      // Line feed.. add new line length
      FLineLengths.Add(Pointer(LineLen));
      LineLen := 0.0;
    end
    else if Char in DISPLAY_CHARS then
      LineLen := LineLen + FMetrics[Char].ScaledWidth + FKerning;
  end;

  // Add last line if unterminated with LF
  if LineLen > 0.0 then FLineLengths.Add(Pointer(LineLen));
end;

procedure TAHMDXFont.TextRect(Rect, ClipRect: TAHMRectF; Text: String; Align: TAHMTextAlign;
                              WordWrap, Clip: Boolean; Scroller: TAHMAbstractScroller;
                              Shade: TAHMCanvasShade; Gamma: TAHMCanvasColour;
                              XScale, YScale: Single; XFlip, YFlip: Boolean);
type
  TColourAdjust = array[TColourType] of Single;
var
  SrcRect, DestRect, ShadowRect: TAHMRectF;
  DestX, DestY, DestWidth, DestHeight: Single;
  HOffset, VOffset, InitWidth, LineLen, ClipScale: Single;
  i, Char, Line: Integer;
  HClipping, VClipping: Boolean;
  UseShade, SkipLine, ClipTop, ClipBottom: Boolean;

  // Local function to handle moving to next vertical line. Returns false
  // when we have finished rendering (text is outside clipping area)
  function MoveToNextLine: Boolean;
  begin
    // Default result - line requires rendering
    Result := True;

    // Advance to next line number and get its length
    Inc(Line);
    LineLen := LineLength[Line];

    // Don't adjust destination if skipping rendering for a line
    if SkipLine then
    begin
      VOffset := VOffset - FPitch;
      SkipLine := False;
    end
    else DestY := DestY + FPitch;

    // Adjust destination for partial vertical clipping
    if ClipTop then
    begin
      DestY := DestY - VOffset;
      VOffset := 0;
      ClipTop := False;
    end;

    // If using vertical pixel clipping perform clipping checks once per line
    if VClipping then
    begin
      if DestY + FPitch < VOffset then
      begin
         // line is entirely above clipping area so we can skip it
        SkipLine := True;
      end
      else if DestY < VOffset then
      begin
        // line is partially clipped above so we need to render it
        ClipTop := True;
      end
      else if DestY > Rect.Height then
      begin
        // line is entirely below clipping area so we can finish
        if (Scroller <> nil) and Scroller.Vertical then Scroller.ScrollingRequired;
        Result := False;
      end
      else if DestY + FPitch > Rect.Height then
      begin
        // line is partially clipped below so we need to render it
        ClipBottom := True;
        if (Scroller <> nil) and Scroller.Vertical then Scroller.ScrollingRequired;
      end;
    end
    else
    begin
      // Not pixel clipping, so just use simple vertical clipping
      if DestY + FPitch > Rect.Height then Result := False;
    end;

    // Initialise next line for shading
    DestRect := MakeRectF(0, DestY, 0, FPitch);
    if UseShade then Shade.ShadeLine(DestRect);

    // Calculate horizontal start position for line
    if Align = taRight then DestX := InitWidth - LineLen
    else if Align = taCenter then DestX := (InitWidth - LineLen) / 2
    else DestX := 0;
  end;

begin
  // Initialise clipping/scrolling variables
  VOffset := 0.0;
  HOffset := 0.0;
  VClipping := False;
  HClipping := False;
  DestWidth := 0.0; // fix compiler warning only
  DestHeight := 0.0; // fix compiler warning only

  // Apply wordwrapping to fit text in boundary width if required
  if WordWrap then Text := WordWrapText(Text, Rect.Width);

  // If we want to do any cool formatting then we need to know line lengths
  if Align <> taLeft then CalculateLineLengths(Text);
  InitWidth := Rect.Width;

  // Determine whether we want to use pixel clipping
  if Clip then
  begin
    // Calculate horizontal pixel clipping
    if Align = taLeft then
    begin
      if Rect.X < ClipRect.X then
      begin
        HClipping := True;
        HOffset := ClipRect.X - Rect.X;
        Rect.X := ClipRect.X;
      end
      else if Rect.X + Rect.Width > ClipRect.X + ClipRect.Width then
      begin
        HClipping := True;
        Rect.Width := ClipRect.X + ClipRect.Width - Rect.X;
      end;
    end;

    // Calculate vertical pixel clipping
    if Rect.Y < ClipRect.Y then
    begin
      VClipping := True;
      VOffset := ClipRect.Y - Rect.Y;
      Rect.Y := ClipRect.Y;
    end
    else if Rect.Y + Rect.Height > ClipRect.Y + ClipRect.Height then
    begin
      VClipping := True;
      Rect.Height := ClipRect.Y + ClipRect.Height - Rect.Y;
    end;
  end;

  // Determine whether we want to use text scrolling
  if Scroller is TAHMTextScroller then
  begin
    // Setting scrolltext property updates scroll position
    TAHMTextScroller(Scroller).ScrollText := Text;

    // Decide whether to scroll horizontally or vertically
    if Scroller.Vertical then VOffset := VOffset + Scroller.Position
                         else HOffset := HOffset + Scroller.Position;
    if Scroller.Vertical then VClipping := True else HClipping := True;
  end;

  // Apply gamma correction to font and shadow colours
  if Assigned(FFont.Colour) then
    FFontColour.InternalARGB := FFont.Colour.InternalGammaCorrect(Gamma);
  if Assigned(FFont.ShadowColour) then
    FShadowColour.InternalARGB := FFont.ShadowColour.InternalGammaCorrect(Gamma);

  // Do we need to use a graduated shade for rendering?
  UseShade := Assigned(Shade) and Shade.BeginShadeRect(Rect);
  try
    // Initialise stuff for rendering first line
    Line := -1;
    DestX := 0.0;
    DestY := -FPitch;
    ClipTop := False;
    ClipBottom := False;
    SkipLine := False;

    // Calculate position for first line - only clip it if clipping enabled
    if not MoveToNextLine and VClipping then Exit;

    for i := 1 to Length(Text) do
    begin
      Char := Ord(Text[i]);
      if Char = CHAR_LF then
      begin
        // Calculate position for next line - exit if line is clipped
        if not MoveToNextLine then Exit;
      end
      else
      begin
        // Validate next character to render and get display metrics
        if Char in DISPLAY_CHARS then
        begin
          DestWidth := FMetrics[Char].ScaledWidth;
          DestHeight := FMetrics[Char].ScaledHeight;
          SrcRect := FMetrics[Char].Bounds;
        end
        else if Char = CHAR_CURSOR then
        begin
          DestWidth := FMetrics[DISPLAY_CURSOR].ScaledWidth;
          DestHeight := FMetrics[DISPLAY_CURSOR].ScaledHeight;
          SrcRect := FMetrics[DISPLAY_CURSOR].Bounds;
        end
        else
          Continue; // Skip invalid characters

        // Adjust text position when using horizontal pixel clipping
        if HClipping then
        begin
          if DestX + DestWidth + FKerning < HOffset then
          begin
            // char is left of clipping area so skip this char
            HOffset := HOffset - DestWidth - FKerning;
            Continue;
          end
          else if DestX < HOffset then
          begin
            // char is partially clipped to left
            ClipScale := FHScale * HOffset;
            SrcRect.X := SrcRect.X + ClipScale;
            SrcRect.Width := SrcRect.Width - ClipScale;
            DestWidth := DestWidth - HOffset;
            HOffset := 0;
          end
          else if DestX + FKerning > Rect.Width then
          begin
            // char is right of clipping area so we can quit
            if (Scroller <> nil) and not Scroller.Vertical then Scroller.ScrollingRequired;
            if WordWrap then Continue else Exit;
          end
          else if DestX + DestWidth > Rect.Width then
          begin
            // char is partially clipped to right
            ClipScale := Rect.Width - DestX - FKerning;
            SrcRect.Width := FHScale * ClipScale;
            DestWidth := ClipScale;
            if (Scroller <> nil) and not Scroller.Vertical then Scroller.ScrollingRequired;
          end;
          end
        else
        begin
          // Not clipping pixels, so just use simple horizontal clipping
          // (unless right aligned - already calculated line lengths)
          if Align <> taRight then
            if DestX + DestWidth + FKerning > Rect.Width then
              if WordWrap then Continue else Exit;
        end;

        // No point in rendering spaces
        if Char <> CHAR_SPC then
        begin
          // Adjust text position when using vertical pixel clipping
          if VClipping then
          begin
            if SkipLine then
            begin
              // char is offscreen, so don't render it
              Continue;
            end
            else if ClipTop then
            begin
              // char is partially clipped above
              ClipScale := FVScale * VOffset;
              SrcRect.Y := SrcRect.Y + ClipScale;
              SrcRect.Height := SrcRect.Height - ClipScale;
              DestHeight := DestHeight - VOffset;
            end
            else if ClipBottom then
            begin
              // char is partially clipped below
              ClipScale := Rect.Height - DestY;
              SrcRect.Height := FVScale * ClipScale;
              DestHeight := ClipScale;
            end;
          end;

          // Convert relative to absolute text coordinates
          DestRect := MakeRectF(Rect.X + DestX, Rect.Y + DestY, DestWidth, DestHeight);

          // Calculate shade colouring based on text position
          if UseShade then Shade.ShadeChar(DestRect);

          // Do we need to draw shadow?
          if FFont.Shadow then
          begin
            ShadowRect := DestRect;
            ShadowRect.X := ShadowRect.X + FFont.ShadowXOffset;
            ShadowRect.Y := ShadowRect.Y + FFont.ShadowYOffset;
            FCache.Render(SrcRect, ShadowRect, Shade, FShadowColour, XScale, YScale, XFlip, YFlip);
          end;

          // Render main font
          FCache.Render(SrcRect, DestRect, Shade, FFontColour, XScale, YScale, XFlip, YFlip);
        end;

        // Cursor is rendered in same position as next character
        if Char <> CHAR_CURSOR then
          DestX := DestX + DestWidth + FKerning;
      end;
    end;
  finally
    // Finalise shade calculation to reset colours
    if UseShade then Shade.EndShadeRect;
  end;
end;

//----------------------------------------------------------------------------//

constructor TAHMDXFontManager.Create;
begin
  inherited Create;

  FFontList := TList.Create;

  // Set default texture quality settings
  SetFontQuality(fqStandard);
end;

destructor TAHMDXFontManager.Destroy;
begin
  FFontList.Free;

  inherited Destroy;
end;

procedure TAHMDXFontManager.SetFontQuality(Quality: TAHMFontQuality);
begin
  // Set texture dimensions based on required font quality
  FMaxTextureWidth := MAX_TEXTURE_WIDTH shr 1;
  FMaxTextureHeight := MAX_TEXTURE_HEIGHT shr 1;
  FMinTextureHeight := MIN_TEXTURE_HEIGHT shr 1;

  if Quality > fqLow then
  begin
    FMaxTextureWidth := FMaxTextureWidth shl Ord(Quality);
    FMaxTextureHeight := FMaxTextureHeight shl Ord(Quality);
    FMinTextureHeight := FMinTextureHeight shl Ord(Quality);
  end;

  // Need to rebuild font caches when quality is changed
  if Quality <> FFontQuality then
  begin
    FFontQuality := Quality;
    ReleaseFonts;
  end;
end;

function TAHMDXFontManager.GetDXFont(Index: Integer): TAHMDXFont;
begin
  Result := TAHMDXFont(FFontList.Items[Index]);
end;

function TAHMDXFontManager.GetCount: Integer;
begin
  Result := FFontList.Count;
end;

function TAHMDXFontManager.AllocateFont(CanvasFont: TAHMCanvasFont): TAHMDXFont;
var
  i: Integer;
begin
  // Set default result - font not allocated
  Result := nil;
  if not Assigned(CanvasFont) then Exit;

  // See if passed font has already been setup as a DirectX font
  for i := 0 to Pred(FFontList.Count) do
    if GetDXFont(i).CanvasFont = CanvasFont then
    begin
      Result := GetDXFont(i);
      Exit;
    end;

  // Font not yet setup, so lets do just that
  Result := TAHMDXFont.Create;
  Result.CanvasFont := CanvasFont;
  FFontList.Add(Result);
end;

procedure TAHMDXFontManager.ReleaseFonts;
var
  i: Integer;
  Font: TAHMDXFont;
begin
  // Release all directx font objects
  for i := 0 to Pred(FFontList.Count) do
  begin
    Font := GetDXFont(i);
    Font.Free;
  end;

  FFontList.Clear;
end;

procedure TAHMDXFontManager.ReleaseFont(CanvasFont: TAHMCanvasFont);
var
  i: Integer;
  Font: TAHMDXFont;
begin
  // Remove specified directx font object
  for i := 0 to Pred(FFontList.Count) do
    if GetDXFont(i).CanvasFont = CanvasFont then
    begin
      Font := GetDXFont(i);
      Font.Free;
      FFontList.Delete(i);
      Break;
    end;
end;

procedure TAHMDXFontManager.TextRect(Rect: TAHMRectF; Font: TAHMCanvasFont; Text: String; Align: TAHMTextAlign;
                                     WordWrap: Boolean; Scroller: TAHMAbstractScroller; Shade: TAHMCanvasShade;
                                     Gamma: TAHMCanvasColour; XScale, YScale: Single; XFlip, YFlip: Boolean);
var
  DXFont: TAHMDXFont;
begin
  // Allocate a font to perform this render
  DXFont := AllocateFont(Font);
  if Assigned(DXFont) then
  begin
    // Build font if not yet assigned
    DXFont.BuildFont(FMaxTextureWidth, FMaxTextureHeight, FMinTextureHeight);

    // Defer rendering to our font object (no clipping)
    DXFont.TextRect(Rect, EmptyRectF, Text, Align, WordWrap, False, Scroller, Shade, Gamma, XScale, YScale, XFlip, YFlip);
  end;
end;

procedure TAHMDXFontManager.TextRect(Rect, ClipRect: TAHMRectF; Font: TAHMCanvasFont; Text: String; Align: TAHMTextAlign;
                                     WordWrap: Boolean; Scroller: TAHMAbstractScroller; Shade: TAHMCanvasShade;
                                     Gamma: TAHMCanvasColour; XScale, YScale: Single; XFlip, YFlip: Boolean);
var
  DXFont: TAHMDXFont;
begin
  // Allocate a font to perform this render
  DXFont := AllocateFont(Font);
  if Assigned(DXFont) then
  begin
    // Build font if not yet assigned
    DXFont.BuildFont(FMaxTextureWidth, FMaxTextureHeight, FMinTextureHeight);

    // Defer rendering to our font object (with clipping)
    DXFont.TextRect(Rect, ClipRect, Text, Align, WordWrap, True, Scroller, Shade, Gamma, XScale, YScale, XFlip, YFlip);
  end;
end;

procedure TAHMDXFontManager.OnLostDevice;
begin
  // Release internal display resources held by each directx font
  ReleaseFonts;
end;

procedure TAHMDXFontManager.OnResetDevice;
begin
  // Nothing to do... we'll reallocate fonts as we render them
end;

procedure TAHMDXFontManager.ReleaseResources;
begin
  // Release internal display resources held by each directx font
  ReleaseFonts;
end;


end.
